home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
etch.zip
/
ETCH.FOR
< prev
Wrap
Text File
|
1992-10-05
|
3KB
|
142 lines
include 'graphapi.fi'
program main
!===========
include 'graph.fi'
if( _setvideomode( _MAXRESMODE ) .eq. 0 )then
print *, 'No graphics adapter present'
stop
endif
if( InitMouse() .eq. 0 )then
print *, 'No mouse driver present'
stop
endif
call Etch()
call _setvideomode( _DEFAULTMODE )
end
subroutine Etch()
!================
! Follow the mouse and draw while the mouse button is pressed.
! If 'Esc' is pressed, clear the screen. If 'End' is pressed, exit.
include 'graph.fi'
integer pen_down, ch
logical button
record /xycoord/ curr_pos, prev_pos
integer kbhit_, getch_
call CursorOn()
pen_down = 0 ! pen is up
loop
call GetPosition( curr_pos, button )
if( button )then ! button pressed
if( pen_down .ne. 1 )then
pen_down = 1
call _moveto( curr_pos.xcoord, curr_pos.ycoord )
prev_pos = curr_pos
else
if( ( prev_pos.xcoord .ne. curr_pos.xcoord ) .or.
+ ( prev_pos.ycoord .ne. curr_pos.ycoord ) )then
call CursorOff()
call _lineto( curr_pos.xcoord, curr_pos.ycoord )
call CursorOn()
prev_pos = curr_pos
endif
endif
else
pen_down = 0
endif
if( kbhit_() .ne. 0 )then
ch = getch_()
if( ch .eq. 0 )then
ch = 256 + getch_()
endif
if( ch .eq. 27 )then ! ESC key
call CursorOff()
call _clearscreen( _GCLEARSCREEN )
call CursorOn()
else if( ch .eq. 335 )then ! END key
return
endif
endif
endloop
end
! Mouse Library
integer function InitMouse()
!===========================
include 'dos.fi'
DS = ES = FS = GS = 0
AX = 0
call fintr( '33'x, regs )
InitMouse = AX
end
subroutine CursorOn()
!====================
include 'dos.fi'
DS = ES = FS = GS = 0
AX = 1
call fintr( '33'x, regs )
end
subroutine CursorOff()
!=====================
include 'dos.fi'
DS = ES = FS = GS = 0
AX = 2
call fintr( '33'x, regs )
end
subroutine GetPosition( pos, left )
!==================================
include 'graph.fi'
include 'dos.fi'
record /xycoord/ pos
logical left
DS = ES = FS = GS = 0
AX = 3
call fintr( '33'x, regs )
pos.xcoord = CX
pos.ycoord = DX
left = BTEST( BX, 0 )
end
subroutine SetPosition( pos )
!============================
include 'graph.fi'
include 'dos.fi'
record /xycoord/ pos
DS = ES = FS = GS = 0
AX = 4
CX = pos.xcoord
DX = pos.ycoord
call fintr( '33'x, regs )
end